home *** CD-ROM | disk | FTP | other *** search
/ Freelog 15 / FREELOG 15.ISO / WebMaster / Perl / PERL5106.ZIP / perl5 / ntt / NT / registry.ntt < prev    next >
Encoding:
Text File  |  1996-01-17  |  3.3 KB  |  154 lines
  1. #Portions (c) 1995 Microsoft Corporation. All rights reserved. 
  2. #        Developed by hip communications inc., http://info.hip.com/info/
  3.  
  4. # reg.ntt
  5. # Tests for NT Extensions - Registry Manipulation Routines
  6. # changed to test new registry extension modules.
  7.  
  8. BEGIN {
  9.  
  10. @INC = qw( ..\dll-src\ext 
  11.        ..\lib ..\ext );
  12.  
  13. }
  14.  
  15. use Win32::Registry;
  16.  
  17. $bug = 1;
  18.  
  19. open( ME, $0 ) || die $!;
  20. $bugs = grep( /^\$bug\+\+;\n$/, <ME> );
  21. close( ME );
  22.  
  23. print "1..$bugs\n";
  24.  
  25. $HKEY_CLASSES_ROOT->Create( 'ntperl.test.key', $hkey)|| print "not ";
  26. print "ok $bug\n";
  27. $bug++;
  28.  
  29. $HKEY_CLASSES_ROOT->DeleteKey( 'ntperl.test.key' )  ?
  30.     print "ok $bug\n" : print "not ok $bug\n";
  31. $bug++;
  32.  
  33.  
  34. $HKEY_CLASSES_ROOT->DeleteKey( 'ntperl.test.key') ?
  35.     print "not ok $bug\n" : print "ok $bug\n";
  36. $bug++;
  37.  
  38.  
  39. $HKEY_CLASSES_ROOT->Create( 'ntperl.test.key',$hkey2 ) ?
  40.     print "ok $bug\n" : print "not ok $bug\n";
  41. $bug++;
  42.  
  43.  
  44. $hkey->Close() ?
  45.     print "ok $bug\n" : print "not ok $bug\n";
  46. $bug++;
  47.  
  48. $HKEY_CLASSES_ROOT->DeleteKey( 'ntperl.test.key' ) ?
  49.     print "ok $bug\n" : print "not ok $bug\n";
  50. $bug++;
  51.  
  52.  
  53. $hkey2->Close() ?
  54.     print "ok $bug\n" : print "not ok $bug\n";
  55. $bug++;
  56.  
  57. #WORKS TO HERE.
  58.  
  59.  
  60. $HKEY_CLASSES_ROOT->Create( 'ntperl.test.key', $hkey ) ?
  61.     print "ok $bug\n" : print "not ok $bug\n";
  62.  
  63. $bug++;
  64. $hkey->Create( 'k0', $sk0 ) || print "not ";
  65. $hkey->Create( 'k1', $sk1 ) || print "not ";
  66. $hkey->Create( 'k2', $sk2 ) || print "not ";
  67. print "ok $bug\n";
  68. $bug++;
  69.  
  70.  
  71. $keys=[];
  72. $hkey->GetKeys( $keys );
  73. print "not " unless ( $#$keys == 2 );
  74. print "ok $bug\n";
  75. $bug++;
  76.  
  77. $i = 0;
  78. foreach ( sort( @$keys ) ) {
  79.     print "not " unless /^k$i$/;
  80.     $i++;
  81. }
  82. print "ok $bug\n";
  83. $bug++;
  84.  
  85. $hkey->SetValue('k0', REG_SZ, "silly piece of info" ) || print "not ";
  86. print "ok $bug\n";
  87. $bug++;
  88.  
  89. $hkey->QueryValue( 'k0', $data ) || print "not ";
  90. $data eq "silly piece of info" || print "not ";
  91. print "ok $bug\n";
  92. $bug++;
  93.  
  94. $sk0->DeleteValue( "\000" ) ?
  95.     print "ok $bug\n" : print "not ok $bug\n";
  96. $bug++;
  97.  
  98. $hkey->QueryValue( 'k0', $data ) || print "not ";
  99. $data eq "silly piece of info" ?
  100. print "not ok $! $bug\n" : print "ok $bug\n";
  101. $bug++;
  102.  
  103. $sk0->DeleteValue( "\000" ) ?
  104.     print "not ok $bug\n" : print "ok $bug\n";
  105. $bug++;
  106.  
  107. $sk0->SetValueEx( 'string0',NULL, REG_SZ, "data0" ) || print "not ";
  108. $sk0->SetValueEx( 'string1',NULL, REG_SZ, "data1" ) || print "not ";
  109. $sk0->SetValueEx( 'string2',NULL, REG_SZ, "data2" ) || print "not ";
  110. print "ok $bug\n";
  111. $bug++;
  112.  
  113. #$sk0->show_me();
  114. $sk0->GetValues( \%values );
  115.  
  116. @keys = keys( %values );
  117. $#keys == 2 || print "not $!";
  118.  
  119. $i = 0;
  120. foreach ( sort( keys( %values ) ) ) {
  121.     $aref = $values{ $_ };
  122.     ( $name, $type, $data ) = @$aref;
  123.     print "not " unless
  124.     ( $name eq "string$i" && $type == ®_SZ && $data eq "data$i" );
  125.     $i++;
  126. }    
  127. print "ok $bug\n";
  128. $bug++;
  129.  
  130. foreach ( 'string0', 'string1', 'string2' ) {
  131.     $sk0->DeleteValue( $_ ) || print "not ";
  132. }
  133. print "ok $bug\n";
  134. $bug++;
  135.  
  136.  
  137. $sk0->Close();
  138. $sk1->Close();
  139. $sk2->Close();
  140.  
  141. $hkey->DeleteKey( 'k0' ) || print "not ";
  142. $hkey->DeleteKey( 'k1' ) || print "not ";
  143. $hkey->DeleteKey( 'k2' ) || print "not ";
  144. print "ok $bug\n";
  145. $bug++;
  146.  
  147. $hkey->Close();
  148.  
  149. $HKEY_CLASSES_ROOT->DeleteKey( 'ntperl.test.key' ) ?
  150.     print "ok $bug\n" : print "not ok $bug\n";
  151. $bug++;
  152.  
  153.  
  154.